COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	HISTORY
C00003 00003	EXECS FOR SPROUT
C00006 00004	EXECS FOR DEPENDENTS 
C00008 00005	AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE 
C00010 00006	EXECS FOR EVENTS
C00011 00007	EXECS FOR POLLING
C00014 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  002000000012  ⊗;


COMMENT ⊗
VERSION 16(10) 1-7-73 BY RHT ADD EXEC FOR DEPENDENTS
VERSION 16(9) 11-30-72 BY RHT ADD EXECS FOR POLLING
VERSION 16(8) 11-24-72 BY RHT CURE POTENTIAL LOSSAGE WITH EXT PROCS
VERSION 16(7) 11-21-72 BY RHT BUG #KG# -- ALLSTO MISSING BEFORE SPROUT
VERSION 16(6) 10-4-72 BY RHT BUG #JM# BLOCK GETTING CONFUSED BY TBITS WORD LOSSAGE
VERSION 16(5) 9-25-72 BY RHT BUG #IY# LIMIT CASES IN WHICH BLOCK GETS A KILL SET
VERSION 16(4) 9-25-72 
VERSION 16(3) 9-25-72 
VERSION 16(2) 9-25-72 
VERSION 16(1) 9-25-72 

⊗;
COMMENT ⊗EXECS FOR SPROUT⊗

BEGIN PROCSS

↑STDOPT:	MOVEI	A,0		;STANDARD CASE IS ALL ZERO
	PUSHJ	P,CREINT	;
	GENMOV(STACK,GETD)	;STACK IT
	POPJ	P,

;;#KG# RHT ↓ (11-21-72) REMEMBER THE ALLSTO
↑SPRIT:	PUSHJ	P,ALLSTO	;
	XCALL	(SPROUT)
	SETZM	ADEPTH		;PRETTY ARBITRARY
	SETZM	SDEPTH		;
	FREBLK	GENLEF+1
	POPJ	P,

↑FPREM:	GETBLK	GENRIG+1
	MOVE	PNT,GENLEF+1	;THE PROCEDURE ID
	HRRM	PNT,$VAL2(LPSA)	;REMEMBER THE PROC WE FORKED
	POPJ	P,

↑SPRPD:	MOVE	LPSA,GENLEF+2
	HLRZ	LPSA,%TLINK(LPSA)	;PROCEDURE SEMBLK
	HRRZ	PNT,$VAL(LPSA)		;PD SEMBLK
	HRRZI	D,TEMP			;
	PUSHJ	P,LODPDA		;GET THE PDA
					;NOW PUSH IT
	HRLI	C,TEMP
	EMIT	<PUSH	RP,NOUSAC!NORLC!USADDR>
	AOS	ADEPTH
	POPJ	P,

STDKL1:	SKIPA	PNT,GENLEF+2
↑STDKLL:				;STANDARD KILL LIST
	MOVE	PNT,GENLEF+1		;FORK SEMBLK
	HRRZ	PNT2,$VAL2(PNT)		;THE PROCEDURE WE FORKED
	HLRZ	LPSA,%TLINK(PNT2)	;THE SECOND BLOCK
	HLRZ	LPSA,%SAVET(LPSA)	;OLD TTOP
;;#JM# RHT MOVE KILL SET PTR (10-4-72) ↓ (1 OF 3)
	HRRZ	PNT,$ACNO(LPSA)	;THE KILL LIST
	TRNN	PNT,-1			;WE BETTER HAVE ONE
	ERR	<THERE IS NO DEFAULT KILL SET FOR THIS PROCEDURE>
	EMIT	<HRRZI TEMP,NOUSAC>
	HRLI	C,TEMP
	EMIT	<PUSH RP,NOUSAC!USADDR!NORLC>
	AOS	ADEPTH
	POPJ	P,

↑BNKLL:
	ERR 	<KILL LIST BY BLOCK NAME NOT IMPLEMENTED>,1
	JRST	STDKLL

↑EKLL:	
	MOVE	PNT,GENLEF		;PICK UP THE SET
	PUSHJ	P,GETAD			;GET SEMANTICS
	TLNN	TBITS,SET		;MUST BE A SET
	JRST	KSER
	TLNE	TBITS,SAFE
	TRNN	TBITS,INTEGR		;BE SURE KILL SET
KSER:	ERR	<NOT A KILL SET>,1
	GENMOV 	(STACK,0)		;STACK IT
	POPJ	P,

↑STKOPT:
	MOVE	PNT,GENLEF+1
	GENMOV	(STACK,GETD)
	POPJ	P,

COMMENT ⊗EXECS FOR DEPENDENTS ⊗

↑BDEPS:	MOVE 	PNT,GENLEF+1
	MOVE	TBITS2,PPSAV		;PARSE STACK
	MOVE	SBITS2,GPSAV		;GEN STACK
BCHK:	HRRZ	C,(TBITS2)		;GET TOKEN
	CAMN	C,%NBLAT		;TOP OF IT ALL?
	ERR	<BLOCK NAME NOT FOUND FOR "DEPENDENTS">,1,NLLVAL
	CAME	C,%NBEG
	JRST	NXTOK			;NOT A BEGIN
	SKIPGE	PNT2,(SBITS2)		;SEMANTICS?
	SKIPN	A,$PNAME+1(PNT2)	;BLOCK NAME?
	JRST	NXTOK			;NONE
	PUSH	SP,$PNAME(PNT2)		;
	PUSH	SP,A			;THIS BLOCK NAME
	PUSH	SP,$PNAME(PNT)		;
	PUSH	SP,$PNAME+1(PNT)	;THE ASKED FOR NAME
	PUSHJ	P,EQU			;COMPARE
	JUMPN	A,BDGOT			; EQUAL
NXTOK:	SOS	SBITS2			;LOOK ON
	SOJA	TBITS2,BCHK		;
BDGOT:	HRRZ	A,$ACNO(PNT2)		;KILL SET SEMBLK
	JUMPE	A,NVCHK			;NO KILL SET
	MOVEM	A,GENLEF+1		;KLUGE TO SET PARAM TO STSET
	PUSHJ	P,STSET			;
	MOVE	A,GENRIG+1		;FINISH OUT KLUGE
	MOVEM	A,GENRIG		;
	POPJ	P,
NVCHK:	ERR	< THIS BLOCK IS NOT KNOWN TO BE ABLE TO HAVE DEPENDENTS >,1
NLLVAL:	JRST	LPPHI			;

COMMENT ⊗AN EXEC TO SET UP A KILL LIST VAR -- IF NEED ONE ⊗

KLNAM:	XWD	0,6
	POINT	7,.+1
	ASCII	/KLST../	;KILL LIST VARIABLE
↑KLSET:				;DECLARE KILL LIST VARIABLE
	MOVE	TBITS,BITS	;IS THE NEW PROCEDURE SIMPLE?
;;#IY# RHT (9-25-72) RESTRICT CIRCUMSTANCES IN WHICH KILL SET GOES OUT
	TLNN	TBITS,SIMPLE!EXTRNL ;OR EXTERNAL
	SKIPE	SIMPSW		;OR INSIDE A SIMPLE PROC
	POPJ	P,		;YES
;;#IY#
	MOVE	PNT,GENLEF+2	;LOOK AT THE BEGIN
;;#JM# RHT 10-4-72 ↓ MOVE KILL SET IN BLOCK SEMBLK (2 OF 3)
	MOVE	TEMP,$ACNO(PNT) ;DO WE HAVE ONE???
	TRNE	TEMP,-1
	POPJ	P,		;THERE IS ONE ALREADY
	PUSH	P,PNAME
	PUSH	P,PNAME+1	;SAVE MUCH CRUFT
	PUSH	P,HPNT
	PUSH	P,BITS
	PUSH	P,NEWSYM
	SETZM	NEWSYM
	HRROI	TEMP,KLNAM+1
	POP	TEMP,PNAME+1
	POP	TEMP,PNAME
	MOVE	TEMP,[XWD SAFE,SET!INTEGR]
	MOVEM	TEMP,BITS
	MOVE	LPSA,SYMTAB
	PUSHJ	P,SHASH
	PUSHJ	P,ENTERS
	MOVE	TEMP,NEWSYM
	MOVE	PNT,GENLEF+2
;;#JM# RHT 10-4-72 ↓ MOVE KILL SET IN BLOCK SEMBLK (3 OF 3)
	HRRM	TEMP,$ACNO(PNT)
	POP	P,NEWSYM	;PUT EM BACK
	POP	P,BITS		;THE WAY THEY WAS
	POP	P,HPNT
	POP	P,PNAME+1
	POP	P,PNAME
	POPJ	P,		;RETURN -- NO PERMANENT DAMAGE (I HOPE)

COMMENT ⊗EXECS FOR EVENTS⊗

↑CSIT:  PUSHJ P,ALLSTO
	XCALL	(CAUSE)
	MOVNI	A,3
	ADDM	A,ADEPTH
	POPJ	P,

↑STKIRG: MOVE 	TBITS,@LEAPSK
	TLNN	TBITS,LPITM
	JRST	BNDLST			;IT BETTER BE A LIST OR THE LIKE
	JRST	BNDITM			;AN ITEM

↑IRIT:	PUSHJ	P,ALLSTO
	XCALL	(INTERROGATE)
	MOVNI	A,2
	ADDM	A,ADEPTH
	POPJ	P,

↑TYPIRG: MOVEI	TBITS,ITMVAR
	MOVEI	SBITS,0
	MOVEI	D,A
	GENMOV	(MARK,0)
	MOVEM	PNT,GENRIG
	MOVE	A,[XWD CLSIDX,TITV]
	MOVEM	A,PARRIG
	POPJ	P,
COMMENT ⊗EXECS FOR POLLING⊗
ZERODATA ()
↑POLINT: 0	;INTERVAL (NO OF INSTRUCTIONS) TO PUT OUT BETWEEN POLLS
		;IF ≤0 THEN DONT PUT OUT ANY POLLS AUTOMATICALLY

PPCNT:	0	;PCNT AT TIME OF LAST EPOLL
ENDDATA

COMMENT ⊗ EPOLL ALWAYS PUTS OUT A POLL -- PRESERVES ALL ACS 
	EXCEPT PERHAPS TEMP & LPSA
⊗

↑EPOLL:	PUSH	P,A		;SO ALL IMPORTANT ACS SAVED
	PUSH	P,C
	HRLZ	C,PCNT
	MOVSM	C,PPCNT		;REMEMBER THIS DAY
	EXCH	C,LIBTAB+RINTRPT;
	EMIT	<SKIPE NOUSAC!USADDR>
	XCALL	<DDFINT>	;DO DEFERED INTERRUPT
	POP	P,C		;
	POP	P,A		;
	POPJ	P,

COMMENT ⊗ CAPOLL PUTS OUT A POLL IF WE REQUIRE AUTO POLLING AND
	A POLL HASNT GONE OUT RECENTLY -- THIS EXEC IS
	CALLED AT STATEMENT LEVEL
⊗
↑CAPOLL:
	SKIPG	A,POLINT	;
	POPJ	P,		;NONE GO OUT AUTOMATICALLY
	ADD	A,PPCNT		;
	CAMLE	A,PCNT		;IS IT TIME
	POPJ	P,		;NO
	JRST	EPOLL		;YES

COMMENT ⊗ APOLL PUTS OUT A POLL IF WE REQUIRE AUTO POLLING ⊗

↑APOLL:	SKIPG	POLINT		;AUTO POLLING?
	POPJ	P,		;NO
	JRST	EPOLL		;YES

COMMENT ⊗REQPLL -- SETS POLINT⊗

↑REQPLL:

	MOVE	PNT,GENLEF+1	;
	PUSHJ	P,GETAD		;GET SEMANTICS
	TLNE	TBITS,CNST	;BETTER BE CONSTANT INTEGER
	TRNN	TBITS,INTEGR	;
	ERR	<INVALID SPEC TO REQUIRE>,1,REQPX
	MOVE	A,$VAL(PNT)	;GET VALUE
	MOVEM	A,POLINT	;
	JUMPG	A,INMAIN
REQPX:	POPJ	P,

BEND PROCSS